home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / boostrs.arc / XDOWS.PAS < prev    next >
Pascal/Delphi Source File  |  1980-01-01  |  861b  |  37 lines

  1. {$IBoDecl}
  2. {$IDows}
  3. {$IPutStr}
  4. {$IStrip}
  5.  
  6. var
  7.    mm, dd, ccyy, len : integer;
  8.  
  9. BEGIN
  10.  
  11.    ClrScr;
  12.    Repeat
  13.       PutStr (h,'Enter the numeric value for any '+
  14.                 'month, day and year',1,1,14);
  15.       PutStr (h,'separated by spaces: ',1,2,14);
  16.       ClrEol;
  17.       read ( s );
  18.       if length(s) > 0 then
  19.       begin
  20.          s   := strip ( S, ' ');
  21.          len := pos(' ',S) - 1;
  22.          val (copy (s,1,len),mm,ecode);
  23.          s := copy (s,len+2,50);
  24.          len := pos(' ',s) - 1 ;
  25.          val (copy (S,1,len),dd,ecode);
  26.          len := length(s) - pos(' ',s);
  27.          val (copy (S,length(s)-len+1,len),ccyy,ecode);
  28.          if ccyy < 100 then
  29.             ccyy := ccyy + 1900;
  30.          PutStr (h,'Day of the week is '+dows(mm,dd,ccyy),
  31.                    1,4,14);
  32.       end;
  33.    until length(s) = 0;
  34.  
  35. END.
  36.  
  37.